home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / terminal / gp161b / mineseek.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-09-13  |  9.2 KB  |  316 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V+,X-}
  2. {$M 1024,0,0}
  3. PROGRAM Minen_Treter;
  4.  
  5. USES DOS,GPRI;
  6. CONST MAXX = 9;
  7.       MAXY = 9;
  8.       nMienen = 10;
  9.       MaxVersuche = 12;
  10.       GameOver : Boolean = FALSE;
  11.  
  12. CONST MIENE = 1; MARKIERT=2; OFFEN=4;
  13. VAR acker   : ARRAY[1..MAXX,1..MAXY] OF Byte;  {* Bit 0 Miene
  14.                                            *     1 markiert als Miene
  15.                                            *     2 bereits draufgetreten
  16.                                            *}
  17.     anzahl  : ARRAY[1..MAXX, 1..MAXY] OF Byte; {* Anzahl der nachbarMienen *}
  18.  
  19.     path     : STRING; { Pfad ins RUN-Direactory }
  20.     command  : STRING; { Kommando-String }
  21.     i, j, k  : BYTE;   { irgendwelche Zähler; i bevorzugt Zeile, j Spalte }
  22.     nMarkiert : INTEGER; { Zählt die Schüsse }
  23.     nFelder,            { Felder, die noch frei sind }
  24.     nTritte  : WORD;    {   "    "  Treffer (was sonst?) }
  25.  
  26.  
  27.  
  28. PROCEDURE hilfe; { Ist noch ausbaufähig, bei /H soll mal'n größerer TEXT kommen... }
  29.                  { Anm. von DH1DAE: Wurde bei der GPRI-Version getan :-)           }
  30.   VAR
  31.     F  : Text;
  32.     S  : String;
  33.  
  34.   BEGIN
  35.     Assign(F,Path+'MINESEEK.HLP');
  36.     Reset(F);
  37.     IF IOResult = 0 THEN BEGIN
  38.       WHILE NOT EoF(F) DO BEGIN
  39.         Readln(F,S);
  40.         SendString(S+#13);
  41.       END;
  42.       Close(F);
  43.     END ELSE BEGIN
  44.       S := 'Leider ist das Helpfile bei einer Explosion einer Mine'#13+
  45.            'zerstört worden. Sri...'#13;
  46.       SendString(S);
  47.     END;
  48.     SendString('>');
  49.   END;
  50.  
  51.  
  52.  
  53.  PROCEDURE new_game; { Saubermänner mit /N, Erstinstallation, oder hat mal jemand gesiegt ? }
  54.  VAR i, a, b   : BYTE;
  55.      x,y       : SHORTINT;
  56.   BEGIN   {$I+}
  57.    FillChar (acker, Sizeof(Acker), #0 ); {* Nieder mit den Schleifen *}
  58.    FillChar (anzahl, Sizeof(Acker), #0 ); {* dto. *}
  59.    RANDOMIZE;           { Naja, ob der Zufall will ? }
  60.    FOR i := 1 TO NMieneN DO {* Mienen legen, wie einst bei der NVA & Co. :-< *}
  61.      BEGIN
  62.      REPEAT
  63.        a := Random(maxx)+1;
  64.        b := Random(maxy)+1;
  65.      UNTIL (acker[a,b] = 0);
  66.      Acker[a,b] := Miene;
  67.      for x := a-1 to a+1 DO
  68.        FOR y := b-1 TO b+1 DO
  69.          IF (x>=1) AND (x<=MAXX) AND (y>=1) AND (y<=MAXX) THEN
  70.            IF Anzahl[x,y] <> 255 THEN Inc( anzahl[x,y] );
  71.      Anzahl[a,b] := 255;
  72.      END;
  73.    nMarkiert := 0;        { Munition bereitlegen, Rohre frei, }
  74.    nTritte := 0;       { und Treffer-Tafel putzen. }
  75.    nFelder := MaxX*MaxY;
  76.   END;
  77.  
  78.  
  79.  PROCEDURE Ausgabe(fAlles:BOOLEAN); { Gibt den aktuellen Spielstand aus, wo nötig }
  80.    VAR i, j: BYTE;
  81.        S : String;
  82.  BEGIN
  83.    S := #13'   ';
  84.    FOR i := 1 TO maxX DO S := S+' '+char(i+ord('A')-1);
  85.    S := S+#13;
  86.    FOR j := 1 TO maxY DO
  87.      BEGIN
  88.        S := S+Chr(j+48)+'  ';  { Zeilennummern?! Naja, das Spiel ist einfach wie BASIC... }
  89.      FOR i := 1 TO 9 DO
  90.       IF (acker[i,j] AND MARKIERT) <> 0
  91.         THEN S := S+' *'
  92.         ELSE IF ((acker[i,j] AND OFFEN) <> 0) OR fAlles
  93.         THEN IF anzahl[i,j] = 0
  94.                THEN                           S := S+' -'
  95.                ELSE IF anzahl[i,j] = 255 THEN S := S+' *'
  96.                                          ELSE
  97.                                            S := S+' '+Chr(anzahl[i,j]+48)
  98.         ELSE S := S+' ?'; {* unbetreten *}
  99.      S := S+#13;
  100.     END;
  101.     SendString(S);
  102.   END;
  103.  
  104.  PROCEDURE statistik; { Verhältnis von Schüssen zu Treffern (oder umgekehrt) }
  105.   VAR
  106.     S  : String;
  107.     S1 : String[2];
  108.   BEGIN
  109.    S := #13+
  110.         'Kleine Statistik:'#13+
  111.         ' Tritte           : ';
  112.    Str(nTritte,S1);
  113.    S := S+S1+#13+
  114.         ' Gefundene Minen  : ';
  115.    Str(nMarkiert,S1);
  116.    S := S+S1+#13;
  117.    IF nMarkiert>0 THEN BEGIN                     { aber nicht durch 0 teilen }
  118.      Str(Round(nMarkiert/nTritte*100),S1);
  119.      S := S+' Treffquote       : '+S1+'%'#13;
  120.    END;
  121.    S := S+#13;
  122.    SendString(S);
  123.   END;
  124.  
  125.  
  126.  
  127.  PROCEDURE Bumm ( i, j:BYTE );  { Handelt alle TREFFER ab, auch mehrfache }
  128.  VAR k, l, m : BYTE;
  129.      ende    : BOOLEAN;
  130.      S       : String;
  131.  
  132.  BEGIN
  133.    S := #13+
  134.         'BUMM ! Auf Position '+Chr(I+64)+Chr(J+48)+' lag ''ne Mine... GAME OVER'#13;
  135.    SendString(S);
  136.    Ausgabe(TRUE); { Spielstand ausgeben nicht vergessen, }
  137.    statistik;   { mit Statistik natürlich, }
  138.    SendString('Ein neues Spiel? (J/N) >');
  139.    GameOver := TRUE;
  140.   END;
  141.  
  142. CONST RekursionTiefe : WORD = 0;
  143.       nAufdeck       : WORD = 0;
  144.  
  145. VAR
  146.   S : String;
  147.  
  148. PROCEDURE Aufdecken ( i, j: BYTE );
  149.   VAR x,y : SHORTINT;
  150.  
  151. BEGIN
  152.   Inc(RekursionTiefe);
  153.   Inc( nAufdeck);
  154.   Dec(nFelder);
  155.   acker[i,j] := acker[i,j] OR OFFEN AND NOT Markiert;
  156.   IF anzahl[i,j] = 0
  157.     THEN BEGIN {* Rekursiv alle Felder mit 0 NachbarMienen sowie deren unmittelbaren Nachbarn aufdecken *}
  158.          FOR x := i-1 to i+1 DO
  159.            FOR y := j-1 TO j+1 DO
  160.              IF (x>=1) AND (x<=MAXX) AND (y>=1) AND (y<=MAXX) THEN
  161.                  IF ((acker[x,y] AND OFFEN) = 0) THEN Aufdecken(x,y);
  162.          END;
  163.   IF RekursionTiefe<=1 THEN
  164.     BEGIN
  165.     IF nAufdeck > 1 THEN BEGIN
  166.       Str(nAufdeck,S);
  167.       SendString('Insgesamt '+S+' gleichzeitig aufgedeckt !'#13);
  168.     END;
  169.     nAufdeck := 0;
  170.     END;
  171.   Dec(RekursionTiefe);
  172. END;
  173.  
  174.  
  175. PROCEDURE Markiere ( i, j: BYTE );
  176. BEGIN
  177.   IF ((acker[i,j] AND OFFEN) <> 0)
  178.     THEN SendString(' Kann nicht markieren: Feld ist schon aufgedeckt !'#13)
  179.     ELSE BEGIN
  180.          acker[i,j] := acker[i,j] XOR Markiert;
  181.          IF (acker[i,j] AND Markiert) <> 0 THEN BEGIN
  182.            Inc(nMarkiert);
  183.            Dec(nFelder);
  184.          END ELSE BEGIN
  185.            Dec(nMarkiert);
  186.            Inc(nFelder);
  187.          END;
  188.     END;
  189. END;
  190.  
  191.  
  192.  
  193. PROCEDURE Intro; far;
  194.  
  195. VAR
  196.   S  : String;
  197.  
  198. BEGIN
  199.   ProgrammEnde := FALSE;
  200.   Path := ParamStr(0);
  201.   WHILE (Path[0] > #0) AND (Path[Byte(Path[0])] <> '\') DO Dec(Path[0]);
  202.  
  203.   New_Game;
  204.   { Mit Titeln protzen? Aber nicht doch... }
  205.   S := #13' Minen SUCHEN - V2.00 - (C) 1992 by DG9EP & DF3VI'#13+
  206.           ' (GPRI-Implementation 1992 by DH1DAE)'#13#13+
  207.           ' /H = Hilfe   /E = Spiel beenden'#13#13;
  208.   SendString(S);
  209.   Ausgabe(FALSE);
  210.   SendString('>');
  211. END;
  212.  
  213.  
  214. PROCEDURE Parser (S : String); far;
  215.  
  216. VAR
  217.   P,N  : Byte;
  218.  
  219. BEGIN
  220.   Dec(S[0]);
  221.   FOR k := 1 TO Byte(S[0]) DO S[k] := upcase (S[k]); { In Großbuchstaben wandeln }
  222.   IF GameOver THEN BEGIN
  223.     IF S[1] = 'J' THEN BEGIN
  224.       GameOver := FALSE;
  225.       New_Game;
  226.       SendString('Also dann, auf ein neues... :-)'#13#13);
  227.       Ausgabe(FALSE);
  228.       SendString('>');
  229.     END ELSE BEGIN
  230.       ProgrammEnde := TRUE;
  231.       SendString('Tschuess...'#13);
  232.     END;
  233.   END ELSE BEGIN
  234.     P := Pos(' ',S);
  235.     N := 0;
  236.     REPEAT
  237.       IF P = 0 THEN P := Byte(S[0])+1;
  238.       Command := Copy(S,1,P-1);
  239.       Delete(S,1,P);
  240.       P := Pos(' ',S);
  241.       IF command='/S' { Für die Buchhalter und so... }
  242.        THEN BEGIN
  243.          statistik;
  244.          IF N > 0 THEN Ausgabe(FALSE);
  245.          SendString('>');
  246.          Exit;
  247.        END;
  248.       IF command='/H' THEN BEGIN
  249.         hilfe;  { Da solls mal nen längeren(!) Text geben }
  250.         Exit;
  251.       END;
  252.       IF Command = '/E' THEN BEGIN
  253.         SendString('Spiel vorzeitig abgebrochen.'#13);
  254.         ProgrammEnde := TRUE;
  255.         Exit;
  256.       END;
  257.       {* folgendes muesste noch Konstantenmaessig abgescheckt werden, aber hab
  258.        * ich keinen Bock mehr fuer *}
  259.       IF NOT ( command[1] IN ['A'..'I'] ) THEN BEGIN
  260.         SendString('Ungueltige Koordinate!'#13'>');
  261.         Exit;
  262.       END;
  263.       IF NOT ( command[2] IN ['1'..'9'] ) THEN BEGIN
  264.         SendString('Ungueltige Koordinate!'#13'>');
  265.         Exit;
  266.       END;
  267.       i := ORD ( command[1] ) -64;  { Und Zahlen aus den Zeichen machen, ist irgendwie flexibler, }
  268.       j := ORD ( command[2] ) -48;  { als wenn man von 'A' bis 'I' zählt (was aber auch geht -> V1.0). }
  269.       Inc (nTritte); { Munition genau zählen }
  270.  
  271.       IF (length(command)>2) AND (upCase (command[3]) = 'M')
  272.           THEN BEGIN
  273.             Markiere(i,j);
  274.           END ELSE
  275.             IF (acker[i,j] AND Miene)<> 0
  276.                  THEN BEGIN
  277.                    Bumm ( i, j );      { Wenn da eine Miene ist, PÄNG }
  278.                    Exit;
  279.                  END ELSE
  280.                    Aufdecken ( i, j ); { sonst Hurra, wir leben noch halt ... }
  281.       Inc(N);
  282.       IF NOT GameOver AND (nFelder = 0) THEN BEGIN
  283.         S := #13#13'**************************************'#13+
  284.                    '* Gratulation, Du hast es geschafft! *'#13+
  285.                    '**************************************'#13#13;
  286.         SendString(S);
  287.         Ausgabe(FALSE);
  288.         Statistik;
  289.         SendString(#13'Ein weiters Spiel ? (J/N) >');
  290.         GameOver := TRUE;
  291.         Exit;
  292.       END ELSE
  293.         IF nMarkiert > MaxVersuche THEN BEGIN
  294.           SendString(#13'Sri, Du hast soeben Dein letztes Minen-Raeumgeraet verbraucht,'#13+
  295.                         'deshalb: GAME OVER!!'#13#13);
  296.           Ausgabe(TRUE);
  297.           Statistik;
  298.           SendString(#13'Ein weiters Spiel ? (J/N) >');
  299.           GameOver := TRUE;
  300.           Exit;
  301.         END;
  302.     UNTIL (Byte(S[0]) = 0);
  303.     Ausgabe(FALSE);
  304.     SendString('>');
  305.   END;
  306. END;
  307.  
  308.  
  309. BEGIN
  310.   IF NOT TaskInit(@Intro,@Parser,NIL,NIL) THEN BEGIN
  311.     Writeln('Dieses Programm kann nur als GP Remote-Programm gestartet werden.');
  312.     Halt;
  313.   END;
  314.   Keep(0);
  315. END.
  316.